HPAVC/HPAVC CD-ROM.iso/pc/MYMUD21.ZIP/MMUD21.ZIP/SOURCE/SOURCE.ZIP/MYMUD.PAS

Pascal/Delphi Source File | 1995-01-21 | 14.8 KB | 560 lines

{$I COPYRGHT.INC}
{$A+,B-,D+,E-,F-,I-,L+,N-,O-,R-,S+,V-}
{$M 30000,0,0}
{$DEFINE debug     }   {Turn on/off the debugging #REC and #FIX commands }
{ $DEFINE SimpleMode}  { Turn on the simple line editor }

Program MyMUD;
Uses MyIO,
     Misc,
     Multi,
     Header,
     BoolExpr,
     BIN_DB,
     LowLevel,
     Meta_Do,
     Norm_do,
     Macro,
{$IfNDef SimpleMode}
     NiceLine,
{$EndIf}
     Timer,
{$IfDef Debug}
     Debug_do,
{$EndIf}
     VerbList;


Const PollTimeOut = 5; { Check for semafore and mail every x seconds }

Var Current     : ContextType;
    Nr          : Integer;
    Stop        : Boolean;
    Command     : String;
    Name        : String[20];
    Prompt      : String[10];
    ExitSave    : Pointer;
    PrevRoom    : Integer;
    MemStatus   : Byte;
    AllOk       : Boolean;

Procedure Do_Short(Var Current : ContextType);
Begin
Current.DB.ReadObj(Current.Room);
My_WriteLn(#13+HighLight+Current.DB.Name+LowLight);
List_Things(Current.DB.ObjRec.Contents,False);
List_Players(Current,Current.DB.ObjRec.Contents);
End;

Procedure Do_ShowVersion;
Begin
My_WriteLn('');
My_WriteLn(MudName+' '+MudVersion+' compiled at '+CompileDate);
My_WriteLn('Original code written by Gerhard Hoogterp,');
My_WriteLn('  Fidonet: 2:283/7.33 or 2:282/100.5');
My_WriteLn('  Internet: [e-mail]');
My_WriteLn('');
End;

Procedure ResetCurrent(Var Current : ContextType);
Begin
Current.DB.ReadObj(Current.Player);
Current.Room:=Current.DB.ObjRec.Location;
Current.Level:=Current.DB.ObjRec.ObjLevel;
Current.Gender:=Current.DB.WhichGender;
Current.PlayerName:=Current.DB.Name;

Multi.UpdateNodeInfo(Current);
Prompt:=Current.PlayerName+'> ';
End;

(*-------------------------------------------*)

(*-------------------------------------------*)

Procedure DoCommand(Var Current : ContextType;InpStr : String);
Var Command : String;
    Comm_T  : VerbTypes;
    Count   : Byte;
    Home    : String;
    Tmp     : Byte;
    SpacePos: Byte;
    Key     : Char;

Begin
{ Tabs -> Spaces }
For Tmp:=1 To Length(InpStr) Do
 If InpStr[Tmp]=#9
    Then InpStr[Tmp]:=' ';

{ Remove leading and trailing spaces }
While (InpStr<>'') and (InpStr[1]=' ') Do Delete(InpStr,1,1);
While (InpStr<>'') And (InpStr[Length(InpStr)]=' ') Do Dec(InpStr[0]);

If InpStr=''
   Then Begin
        Do_Short(Current);
        Exit;
        End;

{ Remove double spaces }

Repeat
 SpacePos:=Pos('  ',InpStr);
 If SpacePos>0
    Then Delete(InpStr,SpacePos,1);
Until SpacePos=0;

{ Translate variables! }

Current.DB.ReadObj(Current.Player);
For Count:=0 To 9 Do
 Begin
 Tmp:=Pos('&'+Nr2Str(Count),InpStr);
 If Tmp>0
    Then Begin
         Delete(InpStr,Tmp,2);
         Insert(Nr2Str(Current.DB.ObjRec.Storage[Count]),InpStr,Tmp);
         End;
 End;




{ Token support }

If InpStr[1]=SAY_TOKEN
   Then Begin
        Do_Say(Current,InpStr);
        Exit;
        End;

If InpStr[1]=POSE_TOKEN
   Then Begin
        Delete(InpStr,1,1);
        SayToAllHere(Current,' '+InpStr);
        My_WriteLn(Current.PlayerName+' '+InpStr);
        Exit;
        End;

If InpStr[1]=WHISPER_TOKEN
   Then Begin
        Delete(InpStr,1,1);
        InpStr:='WHISPER '+InpStr;
        End;

If InpStr[1]=USE_TOKEN
   Then Begin
        Delete(InpStr,1,1);
        InpStr:='USE '+InpStr;
        End;

If can_move(Current,InpStr)
   Then Begin
        do_Move(Current);
        Do_Short(Current);
        Exit;
        End;

If HandledMoveFail  { An acceptable movement, but not accepted }
   Then Exit;

SpacePos:=1;
Command:='';
While (SpacePos<=Length(InpStr)) and (InpStr[SpacePos]<>' ') Do
 Begin
 Command:=Command+Upcase(InpStr[SpacePos]);
 Inc(SpacePos);
 End;
Delete(InpStr,1,SpacePos);

If Not InMacro
   Then Comm_T:=Verb2Key(Command,Current.Level)
   Else Comm_T:=Verb2Key(Command,Wizard_Level);

Case Comm_T of     { the normal commands }
   Help_T       : ShowHelp(Current.Level);
   LHelp_T      : Do_Help(InpStr);
   Look_T       : Begin
                  If Not Do_Look_at(Current,InpStr)
                     Then My_WriteLn('There is no '+InpStr+' here.');
                  End;
   Exam_T       : Do_Examine(Current,InpStr);
   Goto_T       : Begin
                  If Can_Move(Current,InpStr)
                     Then Begin
                          do_Move(Current);
                          Do_Short(Current);
                          End;
                  End;
   Home_T       : Begin
                  Do_Go_Home(Current,True);
                  Do_Short(Current);
                  End;
   Inv_T        : Do_Inventory(Current);
   Say_T        : Do_Say(Current,InpStr);
   Rob_T        : Do_Rob(Current,InpStr);
   Score_T      : Do_Score(Current);
   Get_T        : Do_Get(Current,InpStr);
   Drop_T       : Do_Drop(Current,InpStr);
   Quit_T       : Stop:=True;
   News_T       : Begin
                  If ExistFile(TextPath+'NEWS.MUD')
                     Then ShowFile(TextPath+'NEWS.MUD')
                     Else ShowFile(HomeDir+'NEWS.MUD');
                  End;
   Kill_T       : Do_Kill(Current,InpStr);

   WhoOn_T      : Do_WhosOn;
   Version_T    : Do_ShowVersion;
   Give_T       : Do_Give(Current,InpStr);
   Whisper_T    : Do_Whisper(Current,InpStr);
   Time_T       : My_WriteLn('Local time here is '+TimeStamp);
   Page_T       : Do_Page(Current,InpStr);
   Use_T        : Do_Use(Current,InpStr);

{ The meta commands }

   RaiseLev_M   : Meta_Change_Level(Current,InpStr,1);
   LowerLev_M   : Meta_Change_Level(Current,InpStr,-1);

   SetFlag_M    : Meta_SetFlag(Current,InpStr);
   WNews_T      : Begin
                  If ExistFile(TextPath+'WNEWS.MUD')
                     Then ShowFile(TextPath+'WNEWS.MUD')
                     Else ShowFile(HomeDir+'WNEWS.MUD');
                  End;
   Stats_M      : ShowLockStat;
   ShoutAll_M   : SayToAll('A voice boomes out of nowhere and says:'#13#10'  "'+InpStr+'"');
   Create_M     : Meta_CreateObj(Current,InpStr);
   Chown_M      : Meta_Chown(Current,InpStr);
   ChangeName_M : Meta_ChangeName(Current,InpStr);
   ShutDown_M   : Begin
                  SayToAll('The Game is going to shut down!');
                  My_Delay(3000);
                  ShutDownGame;
                  Halt(99);
                  End;
   SetLock_M    : Meta_Set_Lock(Current,InpStr);
   Unlock_M     : Meta_Unlock(Current,InpStr);
   SetHome_M    : Meta_HomeHere(Current,InpStr);
   Home_M       : Meta_ChangeHome(Current,InpStr);
   Desc_M       : Meta_Make_Text(Current,InpStr,0);
   Finger_M     : Meta_Finger(Current,InpStr);
   Destroy_M    : {Meta_Destroy(Current,InpStr)} My_WriteLn('Nothing happens');

   Fail_M       : Meta_Make_Text(Current,InpStr,1);
   OFail_M      : Meta_Make_Text(Current,InpStr,3);

   Success_M    : Meta_Make_Text(Current,InpStr,2);
   OSuccess_M   : Meta_Make_Text(Current,InpStr,4);
   Macro_M      : Meta_Make_Text(Current,InpStr,5);

   Info_M       : Begin
                  If Current.Level>Builder_Level
                     Then Meta_Make_Text(Current,InpStr,6)
                     Else Meta_Make_Text(Current,'ME',6);
                  End;

   ChangePass_M : Meta_ChangePassword(Current,InpStr);
   Note_M       : Current.Note:=CleanUp(InpStr);

   Dig_M        : Meta_Dig(Current,InpStr);
   Open_M       : Meta_OpenLink(Current,InpStr);
   Action_M     : Meta_Action(Current,InpStr);
   Find_M       : Meta_Find(Current,InpStr);
   Teleport_M   : Meta_Teleport(Current,InpStr);
   Edit_M       : Meta_Edit(Current,InpStr);

{$IfDef debug}
   ShowRec_D    : DEBUG_ShowRecord(Current,InpStr);
   Fix_D        : Debug_Fix(Current,InpStr);
{$EndIf}

   Wait_At_At   : ;
 Else           Begin
                If InMacro
                   Then Begin
                        Case Comm_T Of
                          Set_Mc    : Macro_Let(Current,InpStr);
                          Random_Mc : Macro_Random(Current,InpStr);
                          Show_MC   : Macro_ShowFile(Current,InpStr);
                          Say_MC    : Macro_SayUser(Current,InpStr);
                          SayAll_MC : Macro_SayAll(Current,InpStr);
                          Pennies_MC: Macro_Pennies(Current,InpStr);
                          IF_Mc     : ;
                        End; {Case}
                        End
                   Else My_WriteLn('Euh?');
                End;
End; {Case command}
End;

{$IfDef SimpleMode}
Function ReadLine(Var Current : ContextType;Prompt : String):String;
Var EOline : Boolean;
    Key    : Char;
    Line   : String;
    Timer  : TimerObject;
    Count  : Byte;
Begin

Timer.SetTimer(PollTimeOut*10);

My_Write(HighLight+Prompt);
Line:='';
EoLine:=False;
Count:=0;
Repeat
 If My_KeyPressed
    Then Begin
         Key:=My_ReadKey;
         Case Key Of
          #0 : Key:=My_ReadKey;
          #27: Begin
               While Line<>'' DO
                Begin
                My_Write(#8' '#8);
                Dec(Line[0]);
                End;
               End;
          #8 : Begin
               If Line<>''
                  Then Begin
                       Dec(Line[0]);
                       My_Write(#8' '#8);
                       End;
               End;
          #13: EoLine:=True;
         Else  Begin
               If Key>=' '
                  Then Begin
                       Line:=Line+Key;
                       My_Write(Key);
                       End
                  Else My_Write(#7);
               End;
         End; {Case}
         End;

If Timer.TimeUp
   Then Begin
        If CheckShutDown
           Then Begin
                My_WriteLn('');
                My_WriteLn(' *** The game has been shut down!');
                Halt;
                End;
        If CheckMail
           Then Begin
                My_Write(#13);
                My_ClrEol;
                My_Write(LowLight);
                ReadMail;
                My_Write(HighLight+Prompt+Line);
                End;
        If CheckResetMe
           Then Begin
                My_WriteLn('');
                ReadLine:='';
                Exit;
                End;
        Timer.SetTimer(15);
        End;
Until EoLine;

My_WriteLn(LowLight);
My_WriteLn('');
ReadLine:=Line;
End;
{$Else}
Function ReadLine(Var Current : ContextType;Prompt : String):String;
Var EoLine : Boolean;
    Line   : String;
    Count  : Byte;

Begin
EoLine:=False;
Line:='';
Count:=0;
Repeat
  Case LineEditor(HighLight+Prompt,Line,70,PollTimeOut*10) Of
    Ready_Status   : Begin
                     ReadLine:=Line;
                     EoLine:=True;
                     End;
    TimeOut_Status : Begin
                     My_Write(LowLight);
                     If CheckShutDown
                        Then Begin
                             My_WriteLn('');
                             My_WriteLn(' *** The game has been shut down!');
                             Halt;
                             End;
                     If CheckMail
                        Then Begin
                             My_Write(#13);
                             My_ClrEol;
                             My_Write(LowLight);
                             Lock('ReadMail');
                             ReadMail;
                             UnLock;
                             My_Write(HighLight+Prompt+Line);
                             End;
                     If CheckResetMe
                        Then Begin
                             My_WriteLn('');
                             ReadLine:='';
                             Exit;
                             End;
                     My_Write(HighLight);
                     End;
  End;
Until EoLine;
My_WriteLn(LowLight);
End;


{$EndIf}

{$F+}
Procedure MudExit;
{$F-}
Begin
ExitProc:=ExitSave;
If IoResult<>0
   Then;
If ExitCode=0
   Then Exit;
If ExitCode=1
   Then My_ClrScr;
My_WriteLn('See you again some other time..');
If ExitCode>1
   Then Begin
        My_WriteLn('ExitCode: '+Nr2Str(ExitCode));
        Current.DB.Final;
        End;

Multi.FreeNode;
Current.Player:=NOTHING;
Multi.UpdateNodeInfo(Current);
End;

Function GrabCommand(Var Macro : String):String;
Var Tmp  : String;
    MPtr : Byte;
Begin
Tmp:='';
MPtr:=1;
While (Macro[MPtr]<>'^') and (MPtr<=Length(Macro)) Do
 Begin
 Tmp:=Tmp+Macro[MPtr];
 Inc(MPtr);
 End;
Delete(Macro,1,MPtr);
GrabCommand:=Tmp;
End;




Begin
ExitSave:=ExitProc;
ExitProc:=@MudExit;
Randomize;

My_ClrScr;
Multi.ReadINI;
Multi.GrabNodeNr;

Current.DB.Init;
Repeat
  AllOk:=False;
  Case LogIn(Current) of
   NormalLogin : AllOk:=True;
   NewLogin    : Begin
                 My_WriteLn('Yeah! A newbie!');
                 AllOk:=True;
                 End;
   AskedQuit   : Begin
                 Current.DB.Final;
                 Halt(1);
                 End;
   ShowVersion : Begin
                 My_ClrScr;
                 Do_ShowVersion;
                 My_WaitForKey('─── Press a key ───');
                 End;
   ShowWho     : Begin
                 My_ClrScr;
                 Do_WhosOn;
                 My_WaitForKey('─── Press a key ───');
                 End;
  End; {case}
Until AllOk;

If Current.Player=NOTHING
   Then Halt;
ResetCurrent(Current);

Stop:=False;
My_ClrScr;
My_WriteLn('');
My_WriteLn(HighLight+'Welcome at '+MudName+' '+MudVersion+' ('+CompileDate+')');
My_WriteLn(Current.PlayerName+', you''re on node '+Nr2Str(MyNode)+LowLight);
My_WriteLn('');

Current.Db.ReadObj(Current.Player);

Do_Short(Current);
If Not Current.DB.IsInvisible
   Then SayToAllHere(Current,' appears out of nowhere..');

PrevRoom:=Current.Room;
Current.DB.Final;
MacroString:='';
MemStatus:=Current.Level;
Repeat
 Current.Level:=MemStatus;
 Current.DB.Init;

 Generate_Pennies(Current);
 InMacro:=False;
 If MacroString=''
    Then Command:=ReadLine(Current,Current.PlayerName+'> ')
    Else Begin
         InMacro:=True;
         Command:=GrabCommand(MacroString);
         End;

 LastSentence:=Command;
 ResetCurrent(Current);
 DoCommand(Current,Command);
 Multi.UpdateNodeInfo(Current);
 If (PrevRoom<>Current.Room) And
    (Not Current.DB.IsInvisible)
    Then Begin
         SayToAllHere(Current,' arrives.');
         PrevRoom:=Current.Room;
         End;

 If Stop
    Then Begin
         Current.Db.ReadObj(Current.Player);
         If Not Current.DB.IsInvisible
            Then SayToAllHere(Current,' goes home..');
         If Not Current.DB.IsSticky
            Then Do_Go_Home(Current,False);
         End;

 Current.DB.Final;
 {$IfDef Debug}
  If LockLevel<>0
     Then My_WriteLn('DEBUG: LockLevel>0');  { LockLevel should always be 0 after a processed command }
 {$EndIf}
Until Stop;
Halt(1);
End.